
module Main (main) where

import System.IO
import Control.Monad
import System( getArgs )
import System.Console.GetOpt

data Flag = Text
          deriving (Eq)

options :: [OptDescr Flag]
options = [
    Option ['t'] ["text"] (NoArg Text) "output plain text"
  ]

pos :: Int -> Int -> Int -> Int
pos n i j = ((2 * n - 1) * j - j ^ 2 - 2 * n + 2 * i - 2) `div` 2

getDistance :: Int -> [Float] -> Int -> Int -> Float
getDistance n ds i j | i == j = 0.0
                     | i < j = getDistance n ds j i
                     | otherwise = ds !! pos n i j

getColor n | n > 0 && n <= 30 = 1
           | n > 30 && n <= 30 + 28 = 2
           | n > 30 + 28 = 3
           | otherwise = error "invalid index"

outputHeader :: IO ()
outputHeader = do putStrLn "<?xml version=\"1.0\"?>"
                  putStrLn "<!DOCTYPE ggobidata SYSTEM \"ggobi.dtd\">"
                  putStrLn "<ggobidata count=\"2\">"

outputTrailer :: IO ()
outputTrailer = putStrLn "</ggobidata>"

outputElements :: Int -> IO ()
outputElements n = do putStrLn "<data name=\"elements\">"
                      putStrLn "<description> </description>"
                      putStrLn "<variables count=\"0\">"
                      putStrLn "</variables>"
                      putStrLn $ "<records count=\"" ++ show n ++ "\" glyph=\"fr 1\">"
                      forM_ [ i | i <- [1..n] ] outputElement
                      putStrLn "</records>"
                      putStrLn "</data>"
    where
      outputElement :: Int -> IO ()
      outputElement n = do putStr $ "  <record id=\"" ++ show n ++ "\""
                           putStr " label=\"Program\""
                           putStr $ " color=\"" ++ show (getColor n) ++ "\""
                           putStrLn "> </record>"

outputDisMatrix :: Int -> [Float] -> IO ()
outputDisMatrix n ds = do putStrLn "<data name=\"distance\">"
                          putStrLn "<description> </description>"
                          putStrLn "<variables count=\"1\">"
                          putStrLn "  <realvariable name=\"D\" nickname=\"D\"/>"
                          putStrLn "</variables>"
                          putStrLn $ "<records count=\"" ++ show (n ^ 2 - n) ++ "\" glyph=\"fr 1\" color=\"0\">"
                          forM_ [ (i, j) | i <- [1..n], j <- [1..n], i /= j ] outputDistance
                          putStrLn "</records>"
                          putStrLn "</data>"
    where
      outputDistance :: (Int, Int) -> IO ()
      outputDistance (i, j) = do putStr $ "  <record source=\"" ++ show i ++ "\""
                                 putStr $ " destination=\"" ++ show j ++ "\""
                                 putStrLn $ "> " ++ show (getDistance n ds i j) ++ " </record>"

processGGobi :: Int -> [Float] -> IO ()
processGGobi n ds = do outputHeader
                       outputElements n
                       outputDisMatrix n ds
                       outputTrailer

processText :: Int -> [Float] -> IO ()
processText n ds = forM_ [ i | i <- [1..n] ] outputRow
    where
      outputRow :: Int -> IO ()
      outputRow i = do forM_ [ j | j <- [1..n] ] (outputCell i)
                       putStrLn ""

      outputCell :: Int -> Int -> IO ()
      outputCell i j = putStr $ " " ++ show (getDistance n ds i j)

check :: Int -> [Float] -> IO ()
check n ds = do hPutStrLn stderr "Checking..."
                forM_ [ (i, j, k) | i <- [1..n], j <- [1..n], k <- [1..n], i /= j, j /= k, i /= k ] aux
                hPutStrLn stderr "Done"
    where
      aux :: (Int, Int, Int) -> IO ()
      aux (i, j, k) = if d1 > d2 + d3
                      then hPutStrLn stderr ("ERROR " ++ show i ++ " " ++ show j ++ " " ++ show k)
                      else return ()
          where
            d1 = getDistance n ds i j
            d2 = getDistance n ds i k
            d3 = getDistance n ds k j

main :: IO ()
main = do args <- getArgs
          let (flags, _, _) = getOpt RequireOrder options args
          s <- getContents
          let ds = map read (words s)
          let l = length ds
          let n = truncate $ (1 + sqrt (1 + 8 * fromIntegral l)) / 2
          -- check n ds
          (if Text `elem` flags then processText else processGGobi) n ds
